unit CPSVGExport;

interface

uses Classes, Controls, Windows, Graphics, Contnrs, CPBase, CPPlotExport;

const
  ECreator = 'Crispy Plotter (http://cplotter.sourceforge.net/)';
  EDefs =
    '  <clipPath id="clip">'#13#10 +
    '  <rect width="%2:g" height="%3:g" x="0" y="0"'#13#10 +
    '   style="opacity:0;fill:#000000;stroke:none;"/>'#13#10 +
    '  </clipPath>'#13#10;

  { InchWidth(%g), InchHeight(%g), ViewWidth(%g), ViewHeight(%g) }
  EDocStart =
    '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'#13#10 +
    '<!-- Created with ' + ECreator + ' -->'#13#10 +
    '<svg'#13#10 +
    '   xmlns:svg="http://www.w3.org/2000/svg"'#13#10 +
    '   xmlns="http://www.w3.org/2000/svg"'#13#10 +
    '   version="1.0"'#13#10 +
    '   width="%0:gin"'#13#10 +
    '   height="%1:gin"'#13#10 +
    '   viewBox="0 0 %2:g %3:g">'#13#10 +
    '  <defs>'#13#10 + EDefs +
    '  </defs>'#13#10 +
    '  <g clip-path="url(#clip)">'#13#10;

  EDocEnd = '  </g>'#13#10 +
             '</svg>';

  { X(%g), Y(%g), Width(%g), Height(%g), Fill(%s), Stroke(%s) }
  ERect = '<rect x="%g" y="%g" width="%g" height="%g" ' +
          'style="fill:%s;stroke:%s;stroke-width:%g"/>'#13#10;

  { X(%g), Y(%g), Width(%g), Height(%g), Stroke(%s) }
  EFrameRect = '<rect x="%g" y="%g" width="%g" height="%g" ' +
               'style="fill:none;stroke:%s;stroke-width:%g"/>'#13#10;

  { X(%g), Y(%g), Width(%g), Height(%g), Fill(%s) }
  EFillRect = '<rect x="%g" y="%g" width="%g" height="%g" ' +
              'style="fill:%s;stroke:none"/>'#13#10;
  { CX(%g), CY(%g), RX(%g), RY(%g), Fill(%s), Stroke(%s) }
  EEllipse = '<ellipse cx="%g" cy="%g" rx="%g" ry="%g" ' +
             'style="fill:%s;stroke:%s;stroke-width:%g"/>'#13#10;


  { d(%s), Stroke(%s) }
  ELine = '<path d="%s" style="fill:none;stroke:%s;stroke-width:%g"/>'#13#10;

  { X(%g), Y(%g), Family(%s), Size(%d), Style(%s), Weight(%s), Fill(%s),
    Text(%s) }
  EText =
    '<text x="%0:gin" y="%1:gin" style="font-family:%2:s;font-size:%3:g; ' +
    'font-style:%4:s;font-weight:%5:s;fill:%6:s;stroke:none;" ' +
    'xml:space="preserve"><tspan x="%0:g" y="%1:g">%7:s</tspan></text>'#13#10;

type
  TCPSVGExport = class;

  TPathNode = class
  protected
    FPoint: TCPPoint;
  public
    constructor Create(Point: TCPPoint);
    function ToString(Index: Integer): string;
  end;

  { Exports the view of a plotter control to Scalable Vector Graphis file. }
  TCPSVGExport = class(TCPPlotExport)
  protected
    FStream: TStream;
    FPath: TObjectQueue;
    FPathStroke: string;
    FIsArrowPath: Boolean;
    FStroke: string;
    FStrokeWidth: Double;
    FFontHeight: Double;

    FFill: string;
    FFontStyle: string;
    FFontWeight: string;
    FOldDecimalSeparator: Char;
    function ColorToHTMLCode(Color: TColor): string;
    procedure Add(Text: string);
    procedure AddPath;
    procedure SetBrushColor(const Value: TColor); override;
    procedure SetPenColor(const Value: TColor); override;
    procedure SetPenWidth(const Value: TCPFloat); override;
    procedure FontChanged; override;
  public
    constructor Create(Control: TCustomControl; InchWidth, InchHeight,
      UnitsPerInch: Double); override;
    procedure AfterConstruction; override;
    procedure MoveTo(X, Y: TCPFloat); override;
    procedure LineTo(X, Y: TCPFloat); override;
    procedure HorizLine(Y: TCPFloat); override;
    procedure VertLine(X: TCPFloat); override;
    procedure Ellipse(const Bounds: TCPBounds); override;
    procedure Rectangle(const Bounds: TCPBounds); override;
    procedure FrameRect(const Bounds: TCPBounds); override;
    procedure FillRect(const Bounds: TCPBounds); override;
    procedure TextOut(X, Y: TCPFloat; const Text: string); override;
    procedure BeginDraw; override;
    procedure EndDraw; override;
  end;

implementation

uses SysUtils, CPPlotCanvas;

{ TCPSVGExport }

procedure TCPSVGExport.Add(Text: string);
begin
  FStream.WriteBuffer(Text[1], Length(Text));
end;

procedure TCPSVGExport.AddPath;
var
  Index: Integer;
  d: string;
begin
  if (FPath.Count > 1) then
  begin
    Index := 0;
    d := '';
    while (FPath.Count > 0) do
    begin
      d := d + TPathNode(FPath.Pop).ToString(Index);
      Inc(Index);
    end;
    Add(Format(ELine, [d, FPathStroke, FStrokeWidth]));
    FIsArrowPath := false;
  end
  else
    while (FPath.Count > 0) do
      FPath.Pop.Free;
end;


procedure TCPSVGExport.BeginDraw;
begin
  inherited;
  FPath := TObjectQueue.Create;
  FStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyWrite);
  //RebuildFont;
  FOldDecimalSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  Add(Format(EDocStart, [FInchWidth, FInchHeight, FBounds.Width, FBounds.Height]));
  BrushColor := Color;
  FillRect(CPToBounds(0.0, 0.0, FBounds.Width, FBounds.Height));
end;

function TCPSVGExport.ColorToHTMLCode(Color: TColor): string;
type
  TChannels = array[0..3] of Byte;
begin
  Result := '#' + IntToHex(TChannels(Color)[0], 2) +
    IntToHex(TChannels(Color)[1], 2) +
    IntToHex(TChannels(Color)[2], 2);
end;


procedure TCPSVGExport.EndDraw;
begin
  AddPath;
  Add(EDocEnd);
  FStream.Free;
  FPath.Free;
  DecimalSeparator := FOldDecimalSeparator;
  inherited;
end;

procedure TCPSVGExport.FontChanged;
begin
  inherited;
  FFontHeight := PtToUnits(FFont.Size);
  if (fsItalic in FCanvas.Font.Style) then
    FFontStyle := 'italic'
  else
    FFontStyle := 'normal';
  if (fsBold in FCanvas.Font.Style) then
    FFontWeight := 'bold'
  else
    FFontWeight := 'normal';
end;

procedure TCPSVGExport.SetBrushColor(const Value: TColor);
begin
  inherited;
  FFill := ColorToHTMLCode(Value);
end;

procedure TCPSVGExport.SetPenColor(const Value: TColor);
begin
  inherited;
  FStroke := ColorToHTMLCode(Value);
end;

procedure TCPSVGExport.Ellipse(const Bounds: TCPBounds);
var
  CX, CY, RX, RY: Single;
begin
  AddPath;
  RX := (Bounds.Width) / 2;
  RY := (Bounds.Height) / 2;
  CX := Bounds.Left + RX;
  CY := Bounds.Top + RY;
  Add(Format(EEllipse, [CX, CY, RX, RY, FFill, FStroke, FStrokeWidth]));
end;

procedure TCPSVGExport.FillRect(const Bounds: TCPBounds);
begin
  AddPath;
  Add(Format(EFillRect, [Bounds.Left, Bounds.Top,
    Bounds.Width, Bounds.Height, FFill]));
end;

procedure TCPSVGExport.FrameRect(const Bounds: TCPBounds);
begin
  AddPath;
  Add(Format(EFrameRect, [Bounds.Left, Bounds.Top,
    Bounds.Width, Bounds.Height, FStroke, FStrokeWidth]));
end;

procedure TCPSVGExport.LineTo(X, Y: TCPFloat);
begin
  FPath.Push(TPathNode.Create(CPToVector(X, Y)));
  FDrawPos := CPToVector(X, Y);
end;

procedure TCPSVGExport.MoveTo(X, Y: TCPFloat);
begin
  AddPath;
  FPathStroke := ColorToHTMLCode(FPenColor);
  FPath.Push(TPathNode.Create(CPToVector(X, Y)));
  inherited;
end;

procedure TCPSVGExport.Rectangle(const Bounds: TCPBounds);
begin
  AddPath;
  Add(Format(ERect, [Bounds.Left, Bounds.Top,
    Bounds.Width, Bounds.Height, FFill, FStroke, FStrokeWidth]));
end;

procedure TCPSVGExport.TextOut(X, Y: TCPFloat; const Text: string);
begin
  AddPath;
  Add(Format(EText, [X, Y + FFontHeight * 0.77,
     FCanvas.Font.Name, FFontHeight, FFontStyle, FFontWeight,
     FStroke, Text]));
end;

procedure TCPSVGExport.HorizLine(Y: TCPFloat);
begin
  inherited;
  AddPath;
  MoveTo(0.0, Y);
  LineTo(FBounds.Width, Y);
  AddPath;
end;

procedure TCPSVGExport.VertLine(X: TCPFloat);
begin
  inherited;
  AddPath;
  MoveTo(X, 0.0);
  LineTo(X, FBounds.Height);
  AddPath;
end;


procedure TCPSVGExport.AfterConstruction;
begin
  inherited;
  FFileExtension := 'svg';
end;


procedure TCPSVGExport.SetPenWidth(const Value: TCPFloat);
begin
  inherited;
  FStrokeWidth := PtToUnits(FPenWidth);
end;

constructor TCPSVGExport.Create(Control: TCustomControl; InchWidth,
  InchHeight, UnitsPerInch: Double);
begin
  inherited Create(Control, InchWidth, InchHeight, 600);
end;

{ TPathNode }

function TPathNode.ToString(Index: Integer): string;
var
  Command: string;
begin
  case Index of
    0: Command := 'M';
    1: Command := ' L';
  else
    Command := ' ';
  end;
  Result := Command + Format('%g %g',[FPoint.X, FPoint.Y]);
end;

constructor TPathNode.Create(Point: TCPPoint);
begin
  FPoint := Point;
end;

end.
